(* ================================================================== *)
(** Module d'I/O pour la gestion de tableaux de booléens. 
    Bplib, bebopframework *)
(* ================================================================== *)

open BitReader
open BplibTypes

(* ================================================================== *)
(** Etant donne une chaine de caractere avec '0' ou '1', on renvoit le tableau
    de booleen corespondant en filtrant les caractères. 
    @param s une chaine
    @return t un tableau frais. *)
(* ================================================================== *)
let of_string s =
  let q = Queue.create () in
  let len = String.length s in
  for i = 0 to pred len do
    let c = s.[i] in
    if List.mem c ['1';'0']
    then Queue.add (bool_of_char c) q
    else ()
  done;
  Array.init (Queue.length q) (fun _ -> Queue.pop q)

(* ===================================================================== *)
(** Transtypage inverse : écrire un flot de booléen (bool array) dans une string 
    @param t un tableau de booléen
    @return s une string fraiche *)
(* ===================================================================== *)
let to_string = 
  Array.fold_left (fun accu i -> if i then accu^"1" else accu^"0") "" 

(* ===================================================================== *)
(** Lire un flot de bool dans un fichier <b><i>ascii</b></i> en le filtrant
    @param filename le nom du fichier asci 
    @return t un tableau frais
    @raise FileNotFound si la lecture du fichier échoue *) 
(* ===================================================================== *)
(** FIXED : samedi 16 août 2008, 17:52:31 (UTC+0200) lecture avec filtrage // commentaires sur debut de ligne *)
 
let of_asci_file filename =   
  let q = Queue.create () in 
  begin
    try
      let ic = open_in filename in
      begin
	try
	  while true do
	    let line = input_line ic in
	    let len = String.length line in
	    (* Filtrer si c'est un commentaire *)
	    if ( len >= 2 ) && ( line.[0] = '/' ) && ( line.[1] = '/' )
	    then ()
	    else
	      for i = 0 to pred len do
		let c = line.[i] in
		if List.mem c ['1';'0'] 
		then Queue.add (bool_of_char c) q
		else ();
	      done;
	  done;
	  close_in ic;
	  Array.init (Queue.length q) (fun _ -> Queue.pop q)
	with
	| End_of_file -> 
	    close_in ic;
	    Array.init (Queue.length q) (fun _ -> Queue.pop q)
      end
    with
    | Sys_error _ -> raise (FileNotFound filename)
  end

(* ===================================================================== *)
(** Lire un flot de bool dans un fichier <b><i>binaire</b></i> en le filtrant
    @param filename le nom du fichier binaire 
    @return t un tableau frais
    @raise FileNotFound si la lecture du fichier échoue *) 
(* ===================================================================== *)
let of_bin_file filename =  
  let q = Queue.create () in
  begin
    try
      let ic = Bit.bopen_in filename in
      try
	while true do
	  Queue.add (Bit.bread ic) q
	done;
	[||]
      with
      | End_of_file -> 
	  Bit.bclose_in ic; 
	  Array.init (Queue.length q) (fun _ -> Queue.pop q)
    with
    | Sys_error _ -> raise (FileNotFound filename)
  end

(* ===================================================================== *)
(** Ecrire un flot de bool dans un fichier <b><i>ascii</b></i>
    @param t un tableau de booléens
    @param filename le nom du fichier asci *)
(* ===================================================================== *)
let to_asci_file t filename =  
  let taille = Array.length t in
  let oc = open_out filename in
  for i = 0 to pred taille do
    Printf.fprintf oc "%c" (if t.(i) then '1' else '0');
  done;
  Printf.fprintf oc "\n";
  close_out oc

(* ===================================================================== *)
(** Ecrire un flot de bool dans un fichier <b><i>binaire</b></i>
    @param t un tableau de booléens
    @param filename le nom du fichier binaire *)
(* ===================================================================== *)
let to_bin_file t filename = 
  let taille = Array.length t in
  let oc = Bit.bopen_out filename in
  for i = 0 to pred taille do
    Bit.bwrite oc t.(i)
  done;
  Bit.bclose_out oc

(* ===================================================================== *)
(** Ecrire en <b><i>ascii</b></i> un flot de bool dans un channel
    <ul>
    <li> '1' pour true</li>
    <li> '0' pour false</li>
    </ul>
    @param t un tableau de booléens
    @param oc un channel écriture standard *)
(* ===================================================================== *)
let to_asci_channel t oc = 
  let taille = Array.length t in
  for i = 0 to pred taille do
    Printf.fprintf oc "%c" (if t.(i) then '1' else '0');
  done;
  Printf.fprintf oc "\n"

(* ===================================================================== *)
(** Ecrire en <b><i>binaire</b></i> un flot de bool dans un channel binaire
    @param t un tableau de booléens
    @param oc un channel écriture standard *)
(* ===================================================================== *) 
let to_bin_channel t ocf =  
  let taille = Array.length t in
  let oc = Bit.bopen_out_channel ocf in
  for i = 0 to pred taille do
    Bit.bwrite oc t.(i)
  done;
  Bit.bclose_out_channel oc

(* ===================================================================== *)
(** transtypage des tableaux de bits vers les int avec une <b><i>lecture des 
    bits de poids faible à gauche</b></i>
    @param bits un tableau de bits : le moins significatif est bits.(0) 
    @return i l'entier en décimal correspondant *)
(* ===================================================================== *)
let to_int bits =
  let res = ref 0 in
  for i = pred (Array.length bits) downto 0 do
    res := (!res) * 2 + if bits.(i) then 1 else 0
  done;
  !res

(* ===================================================================== *)
(** transtypage des tableaux de bits vers les int avec une <b><i>lecture des 
    bits de poids faible à gauche</b></i> et un signe
    @param bits un tableau de bits : le moins significatif est bits.(0) 
    @return i l'entier signe en décimal correspondant *)
(* ===================================================================== *)
let to_signed_int bits =
  let len = Array.length bits in
  let modo = ref 1 in
  let unsigned_int = 
    let res = ref 0 in
    for i = pred len downto 0 do
      modo := !modo * 2;
      res := (!res) * 2 + if bits.(i) then 1 else 0
    done;
    !res
  in
  if bits.(pred len)
  then unsigned_int - !modo
  else unsigned_int

(* ===================================================================== *)
(** transtypage des int vers les tableaux de bits <b><i>écriture des 
    bits de poids faible à gauche</b></i>.
    On ne crée pas de tableau frais, mais <b><i>on modifie par effet de bord</i></b>
    le contenu du tableau tab. Comme la taille est fixe n, on fait cette opération
    <b><i>modulo 2 ^ n</i></b>.
    @param tab un tableau de bits 
    @param i un entier en décimal *)
(* ===================================================================== *)
let load_of_int tab i =
  let len = Array.length tab in
  let taille = 2 ^$ len in
  (* attention, -3 mod 2 rend -1 par exemple *)
  let j = ref (((i mod taille)+taille) mod taille) in
  let ind = ref 0 in
  for i = 0 to pred len do tab.(i) <- false done;
  while !j <> 0 do
    let (q, r) = (!j / 2, !j mod 2) in
    tab.(!ind) <- r = 1;
    j := q;
    incr(ind);
  done

(* ===================================================================== *)
(** Remplir un tableau avec une fonction d'iteration *)
(* ===================================================================== *)
let load_of_iter tab fct =
  let len = Array.length tab in
  for i = 0 to pred len do
    tab.(i) <- fct ()
  done

(* ===================================================================== *)
(** Remplir un tableau avec une fonction d'iteration dependant de l'indice *)
(* ===================================================================== *)
let load_of_iteri tab fct =
  let len = Array.length tab in
  for i = 0 to pred len do
    tab.(i) <- fct i
  done
(* ===================================================================== *)
